TITLE BASE
;MAIN ROUTINE FOR MOST OF THE NEW KIDS SUITE PROGRAMS.
;TO CHANGE NUMBER OF BUFFERS CHANGE VALUES OF
;	BLKSIZ - NUMBER OF BLOCKS I/P FROM DISK AT A TIME
;	BUF - BUFFER SPACE
EXTERNAL GAMNAM, DOTHNG, DIRECT,GAMENO
INTERNAL MAINLP, TIKCNT
INTERNAL DPINIT, CLEAR, PDPGET, SHOW, KILL, DDRREL
INTERNAL CHINIT, AIVECT, LV2, TYOPTR,   DMDDIR, SPEAK
INTERNAL HSINIT, CHRSAV, NEWBLK, CLRBUF, NAMSAV
INTERNAL DRCTRY,HSTBLK,COMBLK,OUTDIR;
X1←6
X2 ← X1+1
X3 ← X2+1
X4 ← X3+1
X5 ← X4+1
X6 ← X5+1
P←17
A←13	;SAME AS X6
B←14
C←15
HSTCHN←11

TIKCNT:	0	;COUNTS TICKS OF TIME.
PDL:	BLOCK	21

INISH:	;INITIALISE
	MOVE	P,[IOWD 20,PDL]
	PUSHJ	P,HSINIT		;INITIALIZE HISTORY FILE
	MOVEI	A,-=352
	MOVEI	B,=2561
	PUSHJ	P,DPINIT	;DPINIT(-352,2561)
	MOVEI	A,-=512
	MOVEI	B,=512
	PUSHJ	P,AIVECT	;AIVECT(-512,512)
	MOVEI	A,0
	PUSHJ	P,SHOW		;SHOW(0)
	MOVEI	A,2
	MOVEI	B,=69
	MOVEI	C,-=512
	PUSHJ	P,CHINIT	;CHINIT(2,69,-512)
	PUSHJ	P,CLEAR
	MOVEI	A,-=570
	MOVEI	B,=2561
	PUSHJ	P,DPINIT	;DPINIT(-570,2561)
	MOVE	A,GAMNAM
	JUMPE	A,.+2		;SKIP IF NO PIX REQUIRED.
	PUSHJ	P,DDRGET		;READ DIRECTORY
	SPCWAR	1,SWJOB
	JUMPE	A,MAINLP
	MOVEI	A,0
	MOVEI	B,=2561
	PUSHJ	P,DPINIT	;DPINIT(0,2561)
	HALT

SWJOB:	SOS	TIKCNT		;DECREMENT ANY WAITING TIME
	CALL	[SIXBIT /DISMIS/]	;NULL SPACE WAR JOB

MAINLP:	MOVEI	0		;READ NEXT CHARACTER AND EXEC APPROP SEQ
	PUSHJ	P,CLRBUF	;RECORD ANYTHING THAT WAS TYPED
	CALL	[SIXBIT /SLEEP/];SLEEP FOR 0 SECONDS
	TTYUUO	11,		;CLRBFI - CLEAR TYPE-AHEAD
	CLRBFO			;CLEAR TTY BUFFER
	CALL	[SIXBIT /SLEEP/];SLEEP FOR 0 SECONDS
	MOVEI	X1,=200		;TEMP FOR 200
	MOVEM	X1,TIKCNT	;WILL WAIT 3 SECONDS FOR A CHAR.
GROGGY:	INCHRS	X1		;NEXT CHAR IF NOW TYPED
	JRST	.+2
	JRST	CHRFND		;NEW CHARACTER FOUND.
	CALL	[SIXBIT /SLEEP/];WAIT A WHILE
	CAMG	0,TIKCNT
	JRST	GROGGY
	SPCWAR	636367		;KILL SPACE WARWHEN TIME RUNS OUT.
	PUSHJ	P,OUTHIS	;UPDATE HISTORY FILE
	INCHRW	X1		;WAIT FOR AND READ 1 CHARACTER.

	SPCWAR	1,SWJOB

CHRFND:	SETZM	TIKCNT
	ANDI	X1,177		;CHUCK CNTRL BUTTON INFO
	CAIN	X1,044		;TEST FOR DOLLAR
	JRST	GAMCHG		;END OF THIS GAME ANOTHER FOLLOWS

	MOVEI	A,1
	PUSHJ	P,KILL		;CLEAR P.O.G.  1
	MOVEI	A,2
	PUSHJ	P,KILL		;CLEAR P.O.G.  2
	MOVEI	A,3
	PUSHJ	P,KILL		;CLEAR P.O.G.  3

	CAIL	X1,140		;TEST FOR LOWER CASE ALPHABET
	SUBI	X1,040		;RECODE SO BOTH CASES ARE SAME
	PUSHJ	P,CHRSAV	;SAVE CHARACTER IN HISTORY BUFFER
	JRST	DOTHNG		;DO THIS GAME'S THING.

GAMCHG:	SPCWAR	636367		;KILL SPACEWAR JOB.
	PUSHJ	P,HISREL	;UPDATE HIST FILE & RELEASE CHANNEL
	MOVEI	A,0
	MOVEI	B,=2561
	PUSHJ	P,DPINIT	;DPINIT(0,2561)
GAMCH2:	INCHRW	X1		;GET NEXT CHARACTER
	CAIGE	X1,060		;COMPARE TO ZERO
	JRST	GAMCH2		;TRY ANOTHER CHARACTER.
	CAILE	X1,132		;COMPARE TO LETTER Z
	JRST	GAMCHG+1	;TRY NEXT CHARACTER.
	;IF CONTROL FALLS THRU THEN CHARACTER IS BETWEEN 0 AND Z.
	SUBI	X1,040		;CONVERT TO SIXBIT CODING
	LSH	X1,6
	ORM	X1,JNAME	;PUT DIGIT INTO GAME NAME
	PUSHJ	P,DDRREL	;RELEASE CHANNEL
	PTWRS7	NAMADR		;PLACE NAME OF HISTORY FILE IN TTY BUFFER
	MOVEI	0,NEWJOB
	CALL	0,[SIXBIT /SWAP/]

NEWJOB:	SIXBIT	/DSK/
JNAME:	SIXBIT	/GAME/
	SIXBIT	/DMP/		;NO MODE BITS
	XWD	0,0		;GAMES WILL BE (NOK)K PROGRAMS
	0			;ZERO AS PROJECT-PROGRAMMER NAME

;STOLEN LISP DISPLAY PRIMITIVES


COMMENT ⊗

THESE ARE SOME VALUES THAT THE DISPLAY ROUTINES MAY RETURN
(OTHER THAN 0) THAT INDICATE ERROR CONDITIONS:
	1	DISPLAY BUFFER OVERFLOW
	2	SCREWED UP FILE NAME FROM LISP
	3	CAN'T INIT DISK (OOPS)
	4	CAN'T FIND DISPLAY FILE
	5	CAN'T FIND DISPLAY SUBFILE

⊗

OPDEF DPYPOS [XWD 702100,0]
OPDEF DPYSIZ [XWD 702140,0]
OPDEF DPYCLR [XWD 701000,0]
OPDEF UPG [XWD 703000,0]


TYOD:	1
CHCT:	1
LINL:	20

BSIZ←=1000
RV←←6
AV←←106
VIS←←0
EP←←20
INV←←40
DSK←←12		;DSK I/O CHANNEL NO.
SVS←100
SV←2
PAGE
GVECT:	DPB C+1,[POINT 3,C,27]
	DPB C+2,[POINT 3,C,24]
	JRST LV


AIVECT:	MOVEI C,INV+AV
	JRST LV
AVECT:	MOVEI C,VIS+AV
	JRST LV
APT:	MOVEI C,EP+AV
LV:	DPB A,[POINT 11,C,10]
	DPB B,[POINT 11,C,21]
LV2:	AOS A,TYOPTR
	MOVEM C,(A)
LV3:	HRLI A,(<POINT 7,0,35>)
	MOVEM A,TYOPTR#
	HRRZI A,0(A)
	CAIL A,BUF+BSIZ-20
	JRST [MOVEI A,1
		POPJ P,]
	MOVEI A,0
	POPJ P,

RIVECT:	MOVEI C,INV+RV
	JRST RVG
RVECT:	MOVEI C,VIS+RV
	JRST RVG
RPT:	MOVEI C,EP+RV
RVG:	CAIL A,-SVS
	CAIL A,SVS
	JRST LV
	CAIL B,-SVS
	CAIL B,SVS
	JRST LV
	ANDCMI C,RV
	DPB A,[POINT 7,C,22]
	DPB B,[POINT 7,C,29]
	LSH C,20
	ORI C,SV+INV
	MOVE A,@TYOPTR
	TLZ A,777774
	CAIE A,(C)
	JRST LV2
	LSH C,-24
	DPB C,[POINT 16,@TYOPTR,31]
LOCATE:	HRRZ A,TYOPTR
	POPJ P,
PAGE
DTYO:	CAIN A,15	;CARRIAGE RETURN
	JRST EOL
	CAIN A,12	;LINEFEED
	JRST DTYO3
	CAIE A," "	;SPACE
	CAIN A,"	"	;TAB
	JRST SPACING
	SKIPE SPFLG#
	JRST DOSPNG
DTYO2:	MOVEM A,LASTHP
	MOVE A,LINL
	SUB A,CHCT
	EXCH A,LASTHP#
DTYO3:	IDPB A,TYOPTR
	POPJ P,

EOL:	SETOM LASTHP
	SETOM SPFLG
	JRST DTYO3

SPACING:	SETOM SPFLG
	POPJ P,

DOSPNG:	SETZM SPFLG
	PUSH P,A
	MOVE A,LINL
	SUB A,CHCT
	SUBI A,1
	SKIPGE LASTHP
	JRST INDENT
	SUB A,LASTHP
	CAIN A,1
	JRST ONESP
DOSPN3:	IMUL A,CHSIZ
DOSPN4:	LSH A,31
	ORI A,RV+INV
	PUSH P,C
	MOVE C,A
	PUSHJ P,LV2
	POP P,C
DOSPN2:	POP P,A
	JRST DTYO2

ONESP:	MOVEI A," "

	IDPB A,TYOPTR
	JRST DOSPN2
INDENT:	SKIPE DPLM
	JRST INDNT2
	JUMPE A,DOSPN2
	CAIN A,1
	JRST ONESP
INDNT2:	IMUL A,CHSIZ
	ADD A,DPLM
	JRST DOSPN4

DJUMP:	HRLZI C,0(A)
	ORI C,1B31
	JRST LV2

DJSR:	HRLZI C,0(A)
	ORI C,24
	JRST LV2

FIXUP:	HRLM B,0(A)
	POPJ P,

DTYOS:	MOVE A,[JRST DTYO]
	EXCH A,TYOD
	MOVEM A,DTYOO#
	MOVE A,DPHPOS#
	EXCH A,CHCT
	MOVEM A,CCSAV#
	MOVE A,DPLL
	EXCH A,LINL
	MOVEM A,LLSAV#
	JRST FALSE

DTYOU:	MOVE A,DTYOO
	MOVEM A,TYOD
	MOVE A,CCSAV
	EXCH A,CHCT
	MOVEM A,DPHPOS
	MOVE A,LLSAV
	EXCH A,LINL
	MOVEM A,DPLL
	JRST FALSE

CHINIT:	ADDI C,1000
	MOVE A,RESTAB(A)	;CHARACTER WIDTH
	MOVEM A,CHSIZ#
	MOVEM C,DPLM#		;LEFT MARGIN
	MOVEM B,DPLL#		;LINELENGTH
	JRST FALSE

RESTAB←.-1
	10
	14
	16
	20
	30
	40
	60
PAGE
SHOW:	MOVE B,TYOPTR
	SUBI B,BUF-2
	HRRZM B,BUFHD+1
SH2:	DPB A,[POINT 4,SH1,12]
SH1:	UPG BUFHD
FALSE:	MOVEI A,0
	POPJ P,

DPINIT:	DPYSIZ 0(B)
	DPYPOS 0(A)
CLEAR:	MOVEI A,1
	MOVEM A,BUF
	MOVE A,[XWD BUF,BUF+1]
	BLT A,BUF+BSIZ-1
	MOVEI A,BUF-1
	JRST LV3

KILL:	SETZM BUFHD+1
	JRST SH2

IO←A

COMMENT ⊗

	DPGET TAKES THE PNAME OF A DPY FILENAME AS ITS ONLY
ARGUMENT. IT INPUTS THE FILE INTO THE DPY BUFFER.

⊗

DPGET:	MOVEI C,1		;ZERO THE BUFFER
	MOVEM C,BUF
	MOVE C,[XWD BUF,BUF+1]
	BLT C,BUF+BSIZ-1
	MOVEM A,FILE
	PUSHJ P,DPNT		;DO INIT
	PUSHJ P,LOOK		;DO LOOKUP
DPINP1:	INPUT DSK,[IOWD 2,BUFHD
		0]
	MOVE A,BUFHD+1
	ADDI A,2
	MOVN A,A		;GET -(WORD COUNT)
	HRLM A,BUFCOM		;SET UP COMMAND
	USETI DSK,1		;START AT THE BEGINNING
DPINP2:	INPUT DSK,BUFCOM		;GET BUFFER
	RELEASE DSK,0
BUFFIX:	MOVEI A,BUF-1		;RESTORE BUFFER POINTER
	MOVEM A,BUFHD
	MOVE A,BUFHD+1
	MOVEI B,1
	MOVEM B,BUF-2(A)
	MOVEI A,BUF-3(A)		;READY FOR BYTE POINTER IN A
	JRST LV3

DPPUT:	POPJ P,

DPNT:	INIT DSK,17		;INIT BIN MODE
	SIXBIT/DSK/
	XWD DSKO,DSKI
	JRST [MOVEI A,3
		POP P,
		POPJ P,]
	MOVEI A,0
	POPJ P,

LOOK:	SETZM FILE+2
	SETZM FILE+3
DPLKUP:	LOOKUP DSK,FILE
	JRST [MOVEI A,4
		POP P,
		POPJ P,]
	MOVEI A,0
	POPJ P,

COMMENT ⊗

	THIS SECTION CONTAINS SUBRS DDRGET, DDRREL, AND PDPGET.
PDPGET (FOR "PACKED DPGET") PERFORMS THE SAME FUNCTION AS DPGET,
EXCEPT THAT A PACKED DPY FILE IS ASSUMED TO HAVE BEEN LOOKED UP,
THAT ITS DIRECTORY HAS BEEN READ, AND THAT THE "FILE" REFERRED TO
BY THE PDPGET CALL IS IN THE PACKED DPY FILE. THESE INITIALIZATION
FUNCTIONS ARE ALL PERFORMED BY DDRGET, WHICH TAKES THE PNAME OF
THE FILENAME OF A PACKED DPY FILE AS ITS ONLY ARGUMENT. BETWEEN
CALLS ON DDRGET, THE ARGUMENTLESS SUBR DDRREL MUST BE CALLED.

⊗

DDRGET:	MOVEM A,FILE   		;GET SIXBIT OF PACKED DPY FILE
	PUSHJ P,DPNT		;INIT DSK AND LOOKUP FILE
	PUSHJ P,LOOK
	INPUT DSK,[IOWD 1,DIRECT↔0]	;GET NUMBER OF SUB-FILES
	MOVE A,DIRECT		;MAKE NUMBER OF DIRECTORY WORDS
	IMULI A,2
	ADDI A,1
	MOVN A,A		;MAKE IOWD
	HRLM A,DIRCOM
	USETI DSK,1		;GET BACK TO BEGINNING OF FILE
	INPUT DSK,DIRCOM	;GET THE WHOLE DIRECTORY
	MOVE A,DIRECT		;MAKE ADDRESS OF LAST RECORD NO.
	IMULI A,2
	ADDI A,DIRECT
	MOVEM A,DIRECT		;PUT IT WHERE WE CAN FIND IT
	MOVEI A,0
	POPJ P,

DDRREL:	RELEASE DSK,0		;RELEASE DSK CHANNEL
	POPJ P,

PDPGET:	MOVEM A,FILE   		;GET SIXBIT INTO A
	MOVE A,FILE
	MOVEI B,DIRECT+1	;POINT TO 1ST FILE NAME
FSLOOP:	CAMN A,(B)		;HAVE WE A MATCH?
	JRST MATCH		;YES
	ADDI B,2		;NO, TRY NEXT ONE
	CAMG B,DIRECT		;TOO FAR?
	JRST FSLOOP		;NO
	MOVEI A,5
	POPJ P,

MATCH:	USETI DSK,@1(B)		;GET THE RECORD INDICATED
	INPUT DSK,[IOWD 200,BUFHD↔0]	;GET 1ST RECORD
	MOVE A,BUFHD+1		;GET SIZE OF BUFFER
	MOVEI B,BUFHD		;INITIALIZE INPUT LOCATION
MULREC:	CAIG A,200		;ANY MORE RECORDS?
	JRST BUFFIX		;NO, WE ARE DONE
	SUBI A,200
	ADDI B,200
	HRRM B,MRCOM
	INPUT DSK,MRCOM		;GET ANOTHER RECORD
	JRST MULREC

DSKI:	BLOCK 3
DSKO:	BLOCK 3
FILE:	0↔SIXBIT/DPY/↔0↔0
DIRCOM:	IOWD 0,DIRECT↔0
MRCOM:	IOWD 200,0↔0

BUFCOM:	IOWD 2,BUFHD
	0

VAR
LIT

BUFHD:	BUF-1
	0

	0	;LOCATION FOR DPY JSR
BUF:	BLOCK	=4674

ADCHN  ←← 16			;channel for A/D output.
DSKCHN ←← 17			;channel for reading in sound files.
BLKSIZ ←← 1			;NUMBER OF BLOCKS INPUT FROM UDP AT A TIME.
UBUFSZ ←← BLKSIZ*=2336		;BUFFER SIZE IF READING UDP.
DBUFSZ ←← BLKSIZ*=2304		;BUFFER SIZE IF READING FROM SYSTEM.
BUF1 ← BUF
BUF2 ← BUF+UBUFSZ+1		;NOTE  UBUFSZ > DBUFSZ.
PAKST←←1

DMDDIR:	;FIRST INIT A2D IF POSSIBLE.
	SETOM	NITFLG		;EXPECT TO INIT A2D
	INIT ADCHN,517		;INIT AD IN DUMP MODE.
	SIXBIT/AD/
	0
	SETZM	NITFLG		;INDICATE FAILURE.
	;LOCATE FILE ON UDP OR DSK.
	MOVE	B,[SIXBIT /UDP/]
	CALL	B,[SIXBIT /DEVCHR/]
	TRON	B,400000	;SKIP IF BIT 18 IS ONE
	JRST	ASSDSK		;UDP IS NOT ASSIGNED BY ANYONE
				;(IN PARTICULAR NOT BY THIS JOB).
	TLON	B,40		;SKIP IF BIT 12 IS ON
	JRST	ASSDSK		;UDP IS ASSIGNED TO SOMEONE ELSE.
	SETOM	USEUDP		;HOPE THIS STICKS INDICATING FILE WAS
				;FOUND IN UDP DIRECTORY.
	MOVEI	B,UBUFSZ
	MOVEM	B,BUFSZ		;SET THE BUFFER SIZE VARIABLE.
	INIT	DSKCHN,117	;INIT THE UDP IN DUMP MODE.
	SIXBIT	/UDP/
	0
	JRST	ASSDSK		;UDP DOWN - TRY SYSTEM FILES.
	MOVEI	B,BLKSIZ	;NO. OF UDP BLOCKS READ AT ATIME
	MOVEM	B,BLKINC	;THIS IS THE INC FOR EACH READ ORDER
	JRST	START

ASSDSK:	INIT 	DSKCHN,17	;INIT THE DSK IN DUMP MODE.
	SIXBIT	/DSK/
	0
	JRST	[MOVEI A,1	;BOTH DSK AND UDP OUT.
		SKIPE NITFLG	;SKIP IF A2D NOT INITED
		RELEAS ADCHN,
		POPJ P,]
	SETZM	USEUDP		;SIGNIFY FILE IS ON DSK.
	MOVEI	B,DBUFSZ
	MOVEM	B,BUFSZ		;SET APPROPRIATE BUFFER SIZE.
	SETZM	BLKINC		;NO REFERENCE TO BLOCKS IN SYSTEM FILES


START:	MOVEM	A,SFILE
	MOVEM	A,SFILEB
	MOVE	B,[SIXBIT/DMD/]	;YES.
	MOVEM	B,SFILE+1	;SAVE THE EXTENSION IN THE SECOND WORD.
	MOVEM	B,SFILEB+1	;SAVE THE EXTENSION IN THE SECOND WORD.
	SETZM	SFILE+2		;ZERO THE THIRD WORD OF THE FILE INFO.
	SETZM	SFILEB+2	;ZERO THE THIRD WORD OF THE FILE INFO.
	MOVE	B,[SIXBIT/  1KMC/];ALWAYS ASSUME 1,KMC PPN.
	MOVEM	B,SFILE+3	;SAVE THE PPN IN THE FOURTH WORD.
	MOVE	B,[SIXBIT/  3KMC/];OR PERHAPS 3,KMC PPN.
	MOVEM	B,SFILEB+3	;SAVE THE PPN IN THE FOURTH WORD.


	SKIPE	USEUDP		;ARE WE USING THE UDP?
	JRST	UFIND		;USEUDP≠0  =>  YES.
	LOOKUP	DSKCHN,SFILE	;OTHERWISE THE DSK.
	JRST	.+2
	JRST	WOW
	LOOKUP	DSKCHN,SFILEB
	JRST	[MOVEI A,3	;CAN'T FIND THE FILE.
		RELEASE DSKCHN,
		SKIPE NITFLG	;SKIP IF A2D NOT INITED
		RELEAS ADCHN,
		POPJ P,]
WOW:	SETZM	BLKNO		;NO BLOCK NUMBER FOR SYSTEM DISK
	INPUT	DSKCHN,[IOWD 200,BUF
			0]
	MOVE	A,BUF		;SOUND LENGTH
	SUBI	A,200		;SUBTRACT 200 FOR JUNK AT FRONT
	MOVEM	A,FILTH		;SAVE IT MATE.
	MOVEI	A,0
	POPJ	P,

	;FIND THE FILE ON THE UDP.
UFIND:	;START BY READING THE UDP DIRECTORY WHICH IS CONTAINED IN THE
	;BLOCK OF THE UDP GIVEN BY PAKST.
	INPUT	DSKCHN,[IOWD =2336,BUF
			PAKST]
	;THE FIRST UDP WORD IS THE NO. OF DEIRECTORY ENTRIES.
	;THE SECOND WORD IS THE LAST ALTERATION DATE.
	;THE THIRD WORD IS THE NEXT FREE UDP BLOCK.

	MOVEI	B,BUF+2	
	MOVE	A,BUF		;THE DIRECTORY LOOKUP LOOP COUNT.
	LSH	A,1		;TWO WORDS PER ENTRY
	ADD	A,B		;ADDRESS OF TOP ENTRY
FIND1:	CAMN	A,B
	JRST	FINDF		;ESCAPE WHEN NO MORE ENTRIES LEFT
	MOVE	C,SFILE
	CAMN	C,0(A)		;FILE NAMES = ?.
	JRST	FINDX		;SUCCESS
	SUBI	A,2		;MOVE POINTER
	JRST	FIND1		;TRY NEXT ENTRY.

FINDF:	;FILE NOT FOUND IN DIRECTORY OF UDP.
	MOVE	A,SFILE		;GET FILE NAME.
	RELEAS	DSKCHN,
	SETZM	USEUDP
	JRST	ASSDSK

FINDX:	HLR	B,1(A)		;FILE LENGTH
	MOVEM	B,FILTH
	HRRZ	B,1(A)		;STARTING BLOCK NUMBER.
	MOVEM	B,BLKNO
	MOVEI	A,0		;DECLARE VICTORY
	POPJ	P,		;AND GET OUT.


	;SAY THE FILE WHICH WAS SELECTED BY ROUTINE DMDDIR
	;IN EITHER CASE THE APPROPRIATE DEVICE HAS BEEN INIT-ED
	;AND IF THAT IS THE SYSTEM DISK THE 1ST 200 WORDS HAVE
	;CHUCKED. (THESE 200 WORDS DON'T APPEAR IN UDP FILES)

RET←←C

SPEAK:	;IF A2D IS NOT INITED THEN DO IT TO IT.
	MOVE	A,NITFLG
	JUMPN	A,SPLOOP	;JUMP IF NITFLG=-1
	INIT ADCHN,517		;INIT AD IN DUMP MODE.
	SIXBIT/AD/
	0
	JRST	SPEAK		;A2D NOT AVAILABLE.
	SETOM	NITFLG

	;THE FOLLOWING CODE WAS BORROWED FROM 1,LCS.
SPLOOP:	JSP	RET,RWSUB	;READ AND WRITE
	BUF1-1
	JUMPLE	B,SPEAKX	;QUIT IF THAT WAS LAST XFER.
	JSP	RET,RWSUB	;READ/WRITE USING BUF2
	BUF2-1
	JUMPLE	B,SPEAKX	;QUIT IF THAT WAS LAST XFER.
	JRST	SPLOOP

SPEAKX:	;THE SOUND HAS BEEN SOUNDED.
	RELEAS	ADCHN,		;FINISHED WITH D TO A CVTR.
	RELEAS	DSKCHN,		;FINISHED WITH THIS CHANNEL
	SETZM	NITFLG		;INDICATE OTHER CRUMBS MAY USE A2D.
	MOVEI	A,0
	POPJ P,


RWSUB:	;THE READ/WRITE SUBROUTINE USED TWICE ABOVE.
	;  0(RET) GIVES THE BUFFER ADDRESS.
	;  1(RET) GIVES THE NEXT INSTRUCTION.
	;  ON EXIT B WILL BE THE NUMBER OF WORDS YET TO BE PLAYED.
	MOVE	B,FILTH		;NO. OF WORDS TO BE PLAYED.
	SUB	B,BUFSZ		;SUBTRACT TRANSFER LENGTH
	MOVEM	B,FILTH
	MOVN	A,BUFSZ		;WILL COMPUTE -XFER LENGTH IN A
	JUMPG	B,.+2		;SKIP UNLESS LAST TIME.
	SUB	A,B		;-BUFSZ - (XFER LTH - BUFSZ)
	LSH	A,=18		;MOVE TO TOP HALF OF WORD.
	HRR	A,0(RET)	;INSERT START ADDRESS.
	MOVEM	A,INCMD
	MOVEM	A,OUTCMD

	INPUT	DSKCHN,INCMD	;READ TO BUFFER
	MOVE	A,BLKINC	;BLOCK COUNT INCREMENT.
	ADDM	A,BLKNO
	OUTPUT	ADCHN,OUTCMD	;SPEAK NEXT BUFFER.
	JRST	1(RET)		;GET OUT OF S/R


SFILE:	0			;WILL BE A FILE NAME
	SIXBIT	/DMD/
	0
	SIXBIT	/  1KMC/

SFILEB:	0
	SIXBIT	/DMD/
	0
	SIXBIT	/  3KMC/

INCMD:	0			;WILL BE AND INPUT IOWD.
BLKNO:	0			;WILL BE THE SOURCE BLOCK NO FOR UDP INPUT.
	0
FILTH:	0			;WILL BE THE FILE LENGTH OF SOUND INFO
NITFLG:	0			;INDICATES, IF NONZERO, A2D IS INITED.
USEUDP:	0			;ZERO INDICATES SYSTEM DISK,
BLKINC:	0			;INCREMENT FOR BLKNO
OUTCMD:	0			;SET UP IN S/R RWSUB
	3650			;MAGIC BITS FOR 136
OUTBIT:	4010
	0
	0
BUFSZ:	0

;	THIS SECTION CONTAINS ROUTINES TO MANAGE THE HISTORY FILE


HSINIT:	OUTSTR	[ASCIZ /NAME (VISITORS JUST TYPE <RETURN>):/]
	MOVEI	X1,0	;CLEAR AC
	MOVEI	X2,0
	MOVEI	X3,0
	MOVEI	X4,7		;ALLOW FROM 1 TO 6 CHARACTERS
NAMEIN:	INCHRW	X1		;GET A CHARACTER
	CAIN	X1,040		;IF IT IS BLANK,
	JRST	,NAMEIN		; IGNORE IT
	CAIL	X1,140		;TEST FOR LOWER CASE ALPHABET
	SUBI	X1,040		;RECODE SO BOTH CASES ARE SAME
	LSH	X1,1		;SHIFT CHARACTER LEFT A BIT
	ORM	X1,NAMSAV(X2)	;SAVE CHARACTER FOR USE WHEN CHANGING GAMES
	LSH	X1,=-1		;SHIFT CHARACTER BACK INTO PLACE
	AOJ	X2,		;BUMP SAVE POINTER
	SUBI	X1,040		;CONVERT TO SIXBIT
NONBL:	JUMPL	X1,GOTNAM	;IF ITS A CARRIAGE RETURN, NAME IS IN
	LSH	X3,6		;MAKE ROOMN FOR NEW CHARACTER
	ORM	X1,X3		;INSERT IT
	SOJ	X4,		;COUNT IT
	JRST	,NAMEIN	;GO GET ANOTHER
GOTNAM:	CAIE	X4,7		;IF A FILE WAS SPECIFIED,
	JRST	,JUSNAM		; GO PROCESS IT
	MOVE	X2,POPOUT	;IF NO FILE SPECIFIED, ZAP HISTORY ROUTINES
	MOVEM	X2,CHRSAV
	MOVEM	X2,CLRBUF
	MOVEM	X2,HISREL
	MOVEM	X2,OUTHIS
	POPJ	P,		; AND RETURN
JUSNAM:	SOJLE	X4,SAVNAM	;IF FILE NAME IS LEFT-ADJUSTED, GO SAVE IT
	LSH	X3,6		; ELSE SHIFT IT LEFT ONE CHARACTER
	JRST	JUSNAM		; AND GO TEST AGAIN
SAVNAM:	MOVEM	X3,FILNM1
	MOVEM	X3,FILNM2
	INIT	HSTCHN,17		;INITIALIZE IN DUMP MODE
	SIXBIT	/DSK/
	XWD	0,0
	JRST	BADOPN			;ERROR TRAP
	LOOKUP	HSTCHN,FILNM1
	JRST	NOFILE
	ENTER	HSTCHN,FILNM2
	JRST	.+1		; EXPECT FILE TO EXIST
	CALL	X1,[SIXBIT/DATE/]
	MOVEM	X1,TODAY
	CLRBFI				;CLEAR TTY BUFFER
	USETI	HSTCHN,1		;POINT TO DIRECTORY
	IN	HSTCHN,IODIR		;READ IN DIRECTORY
	PUSHJ	P,NEWBLK		;START A NEW BLOCK
POPOUT:	POPJ	P,			; AND RETURN

CHRSAV:	CALL	X5,[SIXBIT/TIMER/]	;GET TIME OF DAY
CHRSV2:	HRRZ	X2,HSTBLK		;GET LOCATION OF LAST ENTRY
	CAIGE	X2,177			;TEST IF IT IS END-OF-BLOCK
	JRST	SAMBLK			; IF NOT, GO ADD AN ENTRY
	PUSHJ	P,COMBLK		; ELSE WRITE BLK & INDICATE ITS COMPLETE
	PUSHJ	P,NEWBLK		;GO SET UP NEW BLOCK
	MOVEI	X2,0			;POINT TO START OF NEW BLOCK
SAMBLK:	AOJ	X2,			;POINT TO NEXT ENTRY
	HRRM	X2,HSTBLK		;SAVE IT
	OR	X5,GAMENO		;BUILD
	ROT	X1,=-7			; NEW
	OR	X5,X1			;  ENTRY
	MOVEI	8,HSTBLK		;POINT TO HISTORY BLOCK
	MOVEM	X5,@HSTBLK		;STORE NEW ENTRY
	ROT	X1,7			;RESTORE CHARACTER
	POPJ	P,			;AND RETURN


NEWBLK:	MOVEI	8,DRCTRY		;POINT TO DIRECTORY
	HRRZ	X2,DRCTRY		;GET LOCATION OF LAST BLOCK ENTRY
	AOJ	X2,			;POINT TO NEXT BLOCK ENTRY
	HRRM	X2,DRCTRY		;SAVE IT
	AOJ	X2,			;GET DISK ADDRESS
	HRRM	X2,COMBLK		;SET UP USETO INST. TO POINT TO NEW BLOCK
	HRRM	X2,OUTHIS		;SET UP USETO INST. TO POINT TO NEW BLOCK
	MOVE	X2,TODAY		;INITIALIZE
	MOVEM	X2,@DRCTRY		; BLOCK ENTRY
	PUSHJ	P,OUTDIR		;WRITE OUT DIRECTORY
	HLLZS	HSTBLK			;CLEAR WORD COUNT IN NEW BLOCK
	POPJ	P,			;RETURN

COMBLK:	USETO	HSTCHN,0		;SET TO COMPLETED BLOCK
	OUT	HSTCHN,IOHIS		;WRITE OUT COMPLETED BLOCK
	MOVEI	8,DRCTRY		;POINT TO BLOCK ENTRY
	HRLZI	X2,400000		;PLACE BLOCK-COMPLETED-INDICATOR
	ORM	X2,@DRCTRY		; IN DIRECTORY
	POPJ	P,			;AND RETURN

OUTHIS:	USETO	HSTCHN,0		;SET TO CURRENT BLOCK	
	OUT	HSTCHN,IOHIS		;WRITE OUT HISTORY BLOCK
	POPJ	P,			; AND RETURN

OUTDIR:	USETO	HSTCHN,1		;OUTPUT
	OUT	HSTCHN,IODIR		; DIRECTORY
	POPJ	P,			;  AND RETURN


CLRBUF:	INCHRS	X1
	POPJ	P,			;RETURN WHEN NO CHARACTERS LEFT
	CALL	X5,[SIXBIT/TIMER/]	;GET TIME OF DAY
	OR	X5,NOTRES		;INDICATE CHARACTER NOT RESPONDED TO
	PUSHJ	P,CHRSV2		;SAVE THE CHARACTER
	JRST	CLRBUF			;CYCLE WHILE CHARACTERS ARE LEFT

HISREL:	PUSHJ	P,COMBLK	;UPDATE HIST FILE & INDICATE BLOCK COMPLETED
	PUSHJ	P,OUTDIR	;WRITE OUT UPDATED DIRECTORY BLOCK
	RELEAS	HSTCHN,0	;RELEASE HISTORY CHANNEL
	POPJ	P,		;AND RETURN



BADOPN:	OUTSTR	[ASCIZ/CHANNEL UNAVAILABLE/]
NOFILE:	OUTSTR	[ASCIZ/HST FILE MISSING/]
	CALL	[SIXBIT/EXIT/]

IODIR:	IOWD	200,DRCTRY
	0
IOHIS:	IOWD	200,HSTBLK
	0

DRCTRY:	BLOCK	200
HSTBLK:	000010000000			;INDIRECT ADRESSING USING REG. 8
	BLOCK	177
FILNM1:	XWD	0,0			;SLOT FOR FILE NAME
	SIXBIT	/HST/			; EXTENSION IS HST
	XWD	0,0
	SIXBIT	/  1KMC/		;PROJECT-PROGRAMMER IS 1,KMC
FILNM2:	XWD	0,0			;SLOT FOR FILE NAME
	SIXBIT	/HST/			; EXTENSION IS HST
	XWD	0,0
	SIXBIT	/  1KMC/		;PROJECT-PROGRAMMER IS 1,KMC
TODAY:	XWD	0,0			;SLOTFOR TODAYS DATE
NOTRES:	002000000000			;FLAG FOR FLUSHED CHARACTERS
NAMADR:	0
	.+1
NAMSAV:	201004020000		;4 LEADING BLANKS, FIFTH CHAR IS NUL
	201004020000
	201004020000
	201004020000
	201004020000
	201004020000
	0
	END	INISH